package VGAPdCommon;

use warnings;
use strict;

#    Pete's Automated VGAP Hosting Thingy
#    Copyright (C) 1997-2004 Peter Harris
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License version 2 as
#    published by the Free Software Foundation.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#    This program is currently hosted at http://www.agamemnon.net/vgap/

BEGIN {
  use Exporter();
  our ($VERSION, @ISA, @EXPORT);

  $VERSION = 0.3;
  @ISA    = qw(Exporter);
  @EXPORT = qw(GenerateCookie HashPassword EnvelopeTo RaceNames helpto
               logit TurnNumber checkbody invalidgame invalidto
               UpdateConfig sendRST rungame NextRunTime );

  *ini = *main::ini;
  *mainini = *main::mainini;
  *Version = *main::Version;
}

our @ini;
our $mainini;
our $Version;

use Net::IMAP::Simple;
use MIME::Parser;
use MIME::Base64;
use Net::SMTP;
use Config::IniFiles;
use Date::Manip;
use Digest::SHA1 'sha1_base64';
use Cwd;
use Text::Wrap;
use Archive::Zip;
use IO::Scalar;

config MIME::ToolUtils DEBUGGING => 0;

sub GetSalt($) {
   my $game = shift;
   my $salt = $ini[$game]->val('General','Salt');
   if (!defined($salt)) {
      $salt = '';
      $salt .= ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64] foreach(1..8);
      $ini[$game]->newval('General','Salt',$salt);
      UpdateConfig($game);
   }
   return $salt;
}

sub GenerateCookie($$$) {
   my $game = shift;
   my $type = shift;
   my $email = shift;
   my $salt = GetSalt($game);

   return sha1_base64($salt, $type, $email);

   # A crypt based implementation would probably want to
   # use <the first letter of $type>.$email , $salt
   # And then trim the first two letters (the salt) from
   # the front of the digest before returning it.
}

sub HashPassword($$) {
   my $game = shift;
   my $pass = shift;

   defined($game) or return sha1_base64('SysadminPasswordSalt','Password',$pass);

   return GenerateCookie($game, 'Password', $pass);
}

sub EnvelopeTo($$) {
   my $to = shift;
   my $subject = shift;

   logit(6,"Generating a message to $to");
   my $smtp = Net::SMTP->new($mainini->val('EMail','SMTP'));
   $smtp->mail($mainini->val('EMail','SMTPUser'));
   $smtp->to($to);
   $smtp->data();

   my $from = $mainini->val('General','VGAPEmail');
   $smtp->datasend("From: Pete\'s Automated VGAP Thingy <$from>\n");
   $smtp->datasend("To: $to\n");
   $smtp->datasend("Subject: [VGA Planets] $subject\n");
   $smtp->datasend("\n");

   return $smtp;
}

sub RaceNames($) {
   my @races = undef;
   my $game = shift;
   if (open FILE, $ini[$game]->val('General','Homedir').'race.nm' or
       open FILE, $ini[$game]->val('General','VGAPdir').'race.nm') {
      my $glob;
      $glob = <FILE>;
      close FILE;
      @races=unpack 'A30'x 11, $glob;
   } else {
      logit(1,"race.nm not found, assuming defaults.");
      @races = ('The Solar Federation',
                'The Lizards',
                'The Bird Men',
                'The Fascists',
                'The Privateers',
                'The Cyborg',
                'The Crystal People',
                'The Evil Empire',
                'The Robots',
                'The Rebels',
                'The Lost Colonies of Man');
   }
   return @races;
}

sub helpto($;$) { # add warnings et al here.
   my $maxlen;
   my $to = shift;

   logit(4,"$to is requesting some help.");

   my $smtp = EnvelopeTo($to, 'Help Message');

   $smtp->datasend("No valid commands found in your message.\n\n") if (shift);

   $smtp->datasend("This is Pete's Automated VGAP Thingy, Version $Version\n\n");
   $smtp->datasend("The thingy will only process email if one of 'VGAP' or 'VGA Planets'\n is in the subject line somewhere.\n\n");
   $smtp->datasend("Commands currently supported by the VGAP thingy:\n");

   local($Text::Wrap::columns) = 73;
   ($maxlen) = reverse sort map {length} keys %main::command;
   foreach my $cmd (sort keys %main::command) {
     my $cmdtext = $main::command{$cmd}->helptext();
     next if (!defined($cmdtext));

     my $cmdheader = sprintf ('%-'.$maxlen.'s - ', $cmd);
     $smtp->datasend(wrap(' ' x 3,
			  ' ' x (3 + $maxlen + 3),
			  $cmdheader, $cmdtext ) ."\n" );
   }

   $smtp->datasend("\n Note that each command must appear on a line by itself.\n");

   $smtp->dataend();
   $smtp->quit;
}

sub logit($@) {
   my $level=shift;
   my $now = ParseDate('today');
   my @logentry = @_;

   chomp(@logentry);
   if ($level <= $main::DebugLog) {
      open FILE,">>$main::LogFileName" or print "Can't open LogFile $main::LogFileName because $!\n";
      print FILE "[$now] ",@logentry,"\n";
      close FILE;
   }

   if ($level <= $main::DebugCon) {
      print "[$now] ",@logentry,"\n";
   }
}

sub TurnNumber($) {
   my $game = shift;
   my $none = $ini[$game]->val('General','Homedir') . "nextturn.hst";

   open(FILE,$none) or return 0;
   binmode FILE;
   sysread FILE,$none,20,0;
   close FILE;
   return unpack('x18S',$none);
}

sub checkbody($$) {
   my $smtp = shift;
   my $game = shift;
   my $status = $ini[$game]->val('General','Status');

   if (uc($status) eq 'OPEN' || uc($status) eq 'INVITATION ONLY') {
      $smtp->datasend("\n Sorry, this game has not started yet.\n");
   } else {
      my @races;
      my $none;
      my $turnnumber = TurnNumber($game);
   
      @races = RaceNames($game);
      $smtp->datasend("\nWe are currently on turn $turnnumber.\n");
      $smtp->datasend("Races that have kindly submitted a .TRN file:\n");
      $none=1;
      foreach my $player (1..11) {
         my $fn;

         if (uc($ini[$game]->val("Player$player",'Active')) eq 'YES') {
            $fn = $ini[$game]->val('General','Homedir');
            $fn .= "player$player.trn";
            $smtp->datasend("    $races[$player-1]\n"), $none=0 if (-e $fn);
         }
      }
      $none and $smtp->datasend("    None.\n");
      $smtp->datasend("\nRaces that have not yet submitted a .TRN file:\n");
      $none=1;
      foreach my $player (1..11) {
         my $fn;

         if (uc($ini[$game]->val("Player$player",'Active')) eq 'YES') {
            $fn = $ini[$game]->val('General','Homedir');
            $fn .= "player$player.trn";
            $smtp->datasend("    $races[$player-1]\n"), $none=0 if (!(-e $fn));
         }
      }
      $none and $smtp->datasend("    None.\n");
      $none=1;
      foreach my $player (1..11) {
         my $fn;

         if (uc($ini[$game]->val("Player$player",'Active')) eq 'COMP') {
            $fn = $ini[$game]->val('General','Homedir');
            $fn .= "player$player.trn";
            if (!(-e $fn)) {
               $none and $smtp->datasend("\nComputer played races:\n");
               $none=0;
               $smtp->datasend("    $races[$player-1]\n");
            }
         }
      }

      $smtp->datasend("\n  The host will");
      $smtp->datasend(" not") if ((uc($status) eq 'PAUSED') or ( uc($ini[$game]->val('Running','RunEarly')) ne 'YES') );
      $smtp->datasend(" run immediately upon reciept of\nany remaining turns.\n");
      if (uc($status) eq 'RUNNING') {
         my $date = UnixDate(ParseDate($ini[$game]->val('NextRun','NextRun')),"on %A, %B the %E at %i:%M%p");
         $smtp->datasend("\n  The host is scheduled to run in any case\n$date\n");
      } elsif (uc($status) eq 'PAUSED') {
         $smtp->datasend("\n  This game is currently Paused\n");
      }
   }
}

sub invalidto($$) {
   my $to = shift;
   my $ia = shift;
   my $smtp = EnvelopeTo($to, 'Invalid Command');

   chomp($ia);
   logit(4,"$to tried to $ia; invalid command.");
   $smtp->datasend("Invalid Command.\nThe following command is invalid, and has been ignored:\n\n$ia");

   $smtp->dataend();
   $smtp->quit;
}

sub invalidgame($$) {
   my $to = shift;
   my $ia = shift;
   my $smtp = EnvelopeTo($to, 'Invalid Game Name Used');

   chomp($ia);
   logit(4,"$to tried to $ia; invalid game name.");
   $smtp->datasend("Invalid Game Name in command:\n\n$ia");

   $smtp->dataend();
   $smtp->quit;
}

sub UpdateConfig($) {
   my $game = shift;
   my $gameini = $mainini->val('GameINI',"Game$game");

   logit(6,"Updating config file $gameini.");
   $ini[$game]->RewriteConfig() or die("Cannot write new $gameini because:\n$!\n");
   $main::initime[$game] = (stat($gameini))[9];
}

sub sendRST($$) {

# Doesn't use EnvelopeTo because we need MIME

   my $game = shift;
   my $player = shift;
   my $to = $ini[$game]->val("Player$player",'Email');
   my $filename;
   my $gamename;
   my $turnnumber = TurnNumber($game);

   my $glob;
   local $/;

   $filename = $ini[$game]->val('General','Homedir') . "player$player.rst";

   if (!open(FILE,$filename)) {
      # Presume sysadmin ran killrace, or PAAGhoul got 'em or something.
      logit(1, "The RST of Player $player won't open. Presuming dead.");
      $ini[$game]->setval("Player$player",'Active','NO');
      UpdateConfig($game);
      return;
   }
   binmode FILE;
   $glob = <FILE>;
   close FILE;

   my $smtp = Net::SMTP->new($mainini->val('EMail','SMTP'));

   $smtp->mail($mainini->val('EMail','SMTPUser'));
   $smtp->to($to);
   $smtp->data();

   $gamename = $ini[$game]->val('General','ShortName');

   my $from = $mainini->val('General','VGAPEmail');
   $smtp->datasend("From: \"Pete\'s Automated VGAP Thingy\" <$from>\n");
   $smtp->datasend("To: \"Player $player of game $gamename\" <$to>\n");
   $smtp->datasend('Subject: [VGA Planets] RST file for '."turn $turnnumber of $gamename.\n");
   $smtp->datasend('MIME-Version: 1.0'."\n");
   $smtp->datasend('Content-Type: multipart/mixed; boundary="troZ"'."\n");
   $smtp->datasend("\n");
   $smtp->datasend("This is a multi-part message in MIME format.\n");

   $filename = $ini[$game]->val('General','Homedir') . "util$player.dat";

   $smtp->datasend("\n--troZ\n");
   $smtp->datasend("Content-Type: text/plain\n");
   $smtp->datasend("Content-Transfer-Encoding: 7bit\n");
   $smtp->datasend("\n");
   if (-e $filename) {
      $smtp->datasend("Here are your files for turn $turnnumber of $gamename\n");
   } else {
      $smtp->datasend("Here is your file for turn $turnnumber of $gamename\n");
   }
   
   if ($ini[$game]->val("Player$player",'Compress') eq 'tgz') {
      $smtp->datasend("\nUnfortunately, tgz compression isn't supported yet.\n");
   }

   if ($ini[$game]->val("Player$player",'Compress') eq 'zip') {
      $smtp->datasend("\n--troZ\n");
      $smtp->datasend('Content-Type: application/octet-stream; name="'."PLAYER$player.ZIP"."\"\n");
      $smtp->datasend('Content-Transfer-Encoding: base64'."\n");
      $smtp->datasend('Content-Disposition: attachment; filename="'."PLAYER$player.ZIP"."\"\n");
      $smtp->datasend("\n");

      my $zip = Archive::Zip->new();

      $zip->addFile($filename, "UTIL$player.DAT") if -e $filename;

      $filename = $ini[$game]->val('General','Homedir') . "player$player.rst";
      $zip->addFile($filename, "PLAYER$player.RST");

      $filename = $ini[$game]->val('General','Homedir') . "xyplan$player.dat";
      $zip->addFile($filename, "XYPLAN.DAT") if -e $filename;

      my $stringy = new IO::Scalar;
      $zip->writeToFileHandle($stringy);
   
      $smtp->datasend(encode_base64(${$stringy->sref}));

   } else {
      $smtp->datasend("\n--troZ\n");
      $smtp->datasend('Content-Type: application/octet-stream; name="'."PLAYER$player.RST"."\"\n");
      $smtp->datasend('Content-Transfer-Encoding: base64'."\n");
      $smtp->datasend('Content-Disposition: attachment; filename="'."PLAYER$player.RST"."\"\n");
      $smtp->datasend("\n");
   
      $smtp->datasend(encode_base64($glob));
   
      if (open(FILE,$filename) ) {
        binmode FILE;
        $glob = <FILE>;
        close FILE;
   
        $smtp->datasend("\n--troZ\n");
        $smtp->datasend('Content-Type: application/octet-stream; name="'."UTIL$player.DAT\"\n");
        $smtp->datasend('Content-Transfer-Encoding: base64'."\n");
        $smtp->datasend('Content-Disposition: attachment; filename="'."UTIL$player.DAT\"\n");
        $smtp->datasend("\n");
   
        $smtp->datasend(encode_base64($glob));
      }
   
      $filename = $ini[$game]->val('General','Homedir') . "xyplan$player.dat";
      if (open(FILE,$filename) ) {
        binmode FILE;
        $glob = <FILE>;
        close FILE;
   
        $smtp->datasend("\n--troZ\n");
        $smtp->datasend('Content-Type: application/octet-stream; name="'."XYPLAN.DAT\"\n");
        $smtp->datasend('Content-Transfer-Encoding: base64'."\n");
        $smtp->datasend('Content-Disposition: attachment; filename="'."XYPLAN.DAT\"\n");
        $smtp->datasend("\n");
   
        $smtp->datasend(encode_base64($glob));
      }
   }
   
   $smtp->datasend("\n--troZ--\n");
   $smtp->dataend;
   $smtp->quit;

   logit(4,"player$player.rst sent!");
}

sub sethookenv($) {
  my $game = shift;

  $ENV{MAININI}    = $mainini->GetFileName();
  $ENV{BACKUPDIR}  = $mainini->val('Backup','Directory');
  $ENV{PLUGINDIR}  = $mainini->val('General','Plugins');
  $ENV{LOGFILE}    = $mainini->val('General','LogFileName');
  $ENV{LOGLEVEL}   = $mainini->val('General','LogFileDebugLevel');
  $ENV{GAMENUMBER} = $game;

  $ENV{LONGNAME}   = $ini[$game]->val('General','LongName');
  $ENV{SHORTNAME}  = $ini[$game]->val('General','ShortName');
  $ENV{HOMEDIR}    = $ini[$game]->val('General','Homedir');
  $ENV{VGAPDIR}    = $ini[$game]->val('General','VGAPdir');
}

sub runhook($$) {
  my $cmdline = shift;
  my $homedir = shift;
  my $cwd = cwd();

  return if (!defined($cmdline));
  return if (!length($cmdline));

  chdir($homedir);

  system($cmdline);

  chdir($cwd);
}

sub rungame($$) {
   my $game = shift;
   my $gamename = $ini[$game]->val('General','ShortName');
   my $now = ParseDate('today');
   my $cmdline;
   my $compline;
   my $compon = 1;
   my ($next,$skip);
   my @skip;
   my $cwd;
   my $homedir = $ini[$game]->val('General','Homedir');

   logit(5,"Running PreRun Hooks for game $gamename.");
   sethookenv($game);
   runhook($mainini->val('Hooks','PreRun'), $homedir);
   runhook($ini[$game]->val('Hooks','PreRun'), $homedir);

   logit(4,"Running Host for game $gamename.");

   $cmdline = $ini[$game]->val('General','HostExecutable');
   $cmdline .= ' '.$homedir;

   $compline = $ini[$game]->val('General','ComputerPlayer');
   $compon = 0 if (length($compline) < 1);
   $compline .= ' '.$homedir;
   $compline .= ' /';

   my $runcomputer = 0;
   foreach my $player (1..11) {
      if (uc($ini[$game]->val("Player$player",'Active')) eq 'COMP' and !(-e $homedir."player$player.trn")) {
         my $token = $player;
         $token = 'a' if ($player == 10);
         $token = 'b' if ($player == 11);
         $compline .= "$token";
         $runcomputer = 1;
      }
   }
# Uncomment the next line for unregistered computer players
#   $compline .= '+';

   $cwd = cwd();
   chdir($ini[$game]->val('General','VGAPdir'));   #sigh.

   `$compline` if ($runcomputer && $compon);
   logit(2,"Host running for $gamename.");
   `$cmdline`;

   chdir($cwd);

   $next = ( (shift)?$now:$ini[$game]->val('NextRun','NextRun') );
   $ini[$game]->setval('NextRun','LastRun',$next);

   $next = NextRunTime($next, $game);

   $ini[$game]->setval('NextRun','NextRun',$next);
   $ini[$game]->setval('NextRun','NextWarn',DateCalc($next,'-'.$ini[$game]->val('Running','Warning') ));

   UpdateConfig($game);

   my $sn = $ini[$game]->val('General','ShortName');
   chdir($mainini->val('Backup','Directory'));

   $cmdline = 'zip -9 -X -j ';
   if (uc($mainini->val('Backup','Style')) eq 'ROTATE') {
      unlink($sn.'5.zip');
      my $rotate;
      for ($rotate=4;$rotate>=1;$rotate--) {
         rename $sn.$rotate.'.zip',
                $sn.($rotate+1).'.zip';
      }
      rename $sn.'.zip',
             $sn.'1.zip';
      $cmdline .= $sn;
   } else {
      mkdir $sn unless (-d $sn);
      chdir $sn;
      $cmdline .= 'turn'.TurnNumber($game);
   }
   $cmdline .= ' '.$homedir;
   $cmdline .= '*';
   `$cmdline`;

   chdir($cwd);

   foreach my $player (1..11) {
      sendRST($game,$player) if (uc($ini[$game]->val("Player$player",'Active')) ne 'NO')
   }

   logit(5,"Running PostRun Hooks for game $gamename.");
   runhook($ini[$game]->val('Hooks','PostRun'), $homedir);
   runhook($mainini->val('Hooks','PostRun'), $homedir);
}

sub NextRunTime($$) {
   my $next = shift;
   my $game = shift;
   my $now = ParseDate('today');

   $next = DateCalc($next,'+'.$ini[$game]->val('Running','Frequency'));
   my @skip = split(/:/,$ini[$game]->val('Running','Exempt'));
   my $flag = 1;
   while ($flag) {
      $flag = 0;
      foreach my $skip (@skip) {
         if ($skip) {
            if (Date_GetNext($now,$skip) le $next) {
               $next = DateCalc($next,'+ 24 hours');
               $flag = 1;
               $skip = 0;
            }
         }
      }
   }

   return $next;
}

1;
